home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / langs / clisp-c.zoo / trace.fas < prev    next >
Encoding:
CLISP byte-compiled Lisp program  |  1993-06-05  |  8.5 KB  |  166 lines
  1. (SYSTEM::VERSION '(SYSTEM::CLISP2 14. LISP:T 210292.))
  2. #Y(#:TOP-LEVEL-FORM-1 #13Y(00 00 00 00 00 01 D4 36 02 30 07 19 01) "LISP")
  3. #Y(#:TOP-LEVEL-FORM-2 #13Y(00 00 00 00 00 01 D4 36 01 2F FF 19 01)
  4.    (TRACE UNTRACE *TRACE-FUNCTION* *TRACE-ARGS* *TRACE-FORM* *TRACE-VALUES*)
  5.   )
  6. #Y(#:TOP-LEVEL-FORM-3 #13Y(00 00 00 00 00 01 D4 36 02 30 07 19 01) "SYSTEM")
  7. #Y(#:TOP-LEVEL-FORM-4 #11Y(00 00 00 00 00 01 D4 2F 5F 19 01)
  8.    (SPECIAL *TRACE-FUNCTION* *TRACE-ARGS* *TRACE-FORM* *TRACE-VALUES*)
  9.   )
  10. #Y(#:TOP-LEVEL-FORM-5
  11.    #20Y(00 00 00 00 00 01 D4 2F 5F D5 83 53 04 D5 5B 2F 56 BF 19 01)
  12.    (SPECIAL *TRACED-FUNCTIONS*) *TRACED-FUNCTIONS*
  13.   )
  14. #Y(#:TOP-LEVEL-FORM-6
  15.    #20Y(00 00 00 00 00 01 D4 2F 5F D5 83 53 04 D5 D6 2F 56 BF 19 01)
  16.    (SPECIAL *TRACE-LEVEL*) *TRACE-LEVEL* 0.
  17.   )
  18. #Y(#:TOP-LEVEL-FORM-7
  19.    #18Y(00 00 00 00 00 01 D4 2D 01 D4 D6 C1 72 30 96 BE 19 01) TRACE
  20.    REMOVE-OLD-DEFINITIONS MACRO
  21.    #Y(TRACE
  22.       #54Y(00 01 00 01 00 08 8C 02 8A 00 05 D5 5B AA 1A 19 BE 19 04 A8 2D 02 1A
  23.            0A 8B 00 92 1F 76 90 02 93 35 00 14 7B 02 16 01 7A 00 92 20 6C 16 01
  24.            A8 2F CC 16 01 55 19 04
  25.           )
  26.       *TRACED-FUNCTIONS* APPEND TRACE1
  27.   )  )
  28. #Y(#:TOP-LEVEL-FORM-8 #16Y(00 00 00 00 00 01 D4 2D 01 D4 D6 30 96 BE 19 01)
  29.    TRACE1 REMOVE-OLD-DEFINITIONS
  30.    #Y(TRACE1
  31.       #550Y(00 01 00 00 80 1C 00 09 00 00 39 09 39 08 39 07 39 06 39 05 39 04
  32.             39 03 39 02 39 01 36 01 6A A4 36 01 6A A4 B4 86 2D 81 A2 DF 5B E0
  33.             E1 E2 B9 73 02 73 02 E3 E4 E5 E2 BC 73 02 73 04 E6 6B 03 1F E7 E8
  34.             E2 BA 73 02 73 02 E3 E9 5D 16 E2 BD 73 02 73 04 5D 17 6B 03 1F 5D
  35.             18 AE 5D 19 E2 BC 73 02 73 02 73 02 AE 5D 1A B1 73 02 73 02 73 02
  36.             E0 5D 1B B1 5D 1C E2 5E 17 73 02 5D 1D 6B 02 1F 73 03 5D 1E 5D 1C
  37.             E2 5E 17 73 02 5D 1F 6B 02 1F B3 73 03 5D 20 E2 5E 17 73 02 5D 21
  38.             6B 02 1F 73 04 5D 22 5C 5D 23 B2 E2 5E 18 73 02 73 05 5D 24 5D 1C
  39.             E2 5E 17 73 02 5D 25 6B 02 1F E2 5E 17 73 02 B4 5D 1E 5D 1C E2 5E
  40.             1B 73 02 5D 26 6B 02 1F 5D 1E 5D 19 E2 5E 1D 73 02 73 02 5D 27 5E
  41.             1D 68 28 5D 29 5D 2A 5D 2B DF 5B E0 5E 22 5D 2C 6B 02 1F 89 1C 80
  42.             DD 00 14 89 1B 80 E6 00 14 5E 22 89 21 80 ED 00 14 5D 2A 5D 30 5D
  43.             2E 5D 31 5E 29 5D 32 6B 02 1F 73 02 73 02 73 01 89 23 80 DF 00 14
  44.             5E 26 89 22 80 E4 00 14 89 24 80 ED 00 14 E0 5E 2D 5D 34 6B 02 1F
  45.             03 35 72 31 03 20 72 6B 02 20 6B 02 1F 73 01 31 02 20 72 6B 03 20
  46.             6B 03 1F 73 03 73 02 5D 31 5D 36 BC 73 02 5D 37 AC 5D 38 5D 39 5D
  47.             3A 5D 3B 5D 3C 5D 3D E2 5E 29 73 02 5D 3E 6B 02 1F 73 02 5D 3F 5D
  48.             40 E2 5E 2A 73 02 73 02 73 02 73 05 AE 6B 02 1F 73 03 5D 41 5D 42
  49.             5D 37 AF 5D 38 5D 39 5D 3A 5D 3B 5D 43 5D 3F 5D 44 5D 40 E2 5E 2E
  50.             73 02 73 02 73 02 73 02 73 05 B1 6B 02 1F 73 03 73 03 59 04 16 01
  51.             EA 73 03 73 03 73 05 73 05 E2 BA 73 01 73 02 59 06 19 0D DD DE B6
  52.             5A 02 5D 2D 5D 2E 5E 1E 73 02 73 02 59 01 1A FF 15 5D 2D 5D 2E 5E
  53.             1D 73 02 73 02 59 01 1A FF 0C E7 5E 22 5D 2F 6B 02 1F 59 01 1A FF
  54.             07 E7 5E 24 5D 33 6B 02 1F 59 01 1A FF 15 5D 2D 5D 2E 5E 24 73 02
  55.             73 02 59 01 1A FF 0E 5D 2D 5D 2E 5E 26 73 02 73 02 59 01 1A FF 05
  56.            )
  57.       :SUPPRESS-IF :STEP-IF :PRE :POST :PRE-BREAK-IF :POST-BREAK-IF :PRE-PRINT
  58.       :POST-PRINT :PRINT "~S: function name should be a symbol, not ~S" TRACE
  59.       BLOCK UNLESS FBOUNDP QUOTE WARN "~S: undefined function ~S" 'TRACE
  60.       ((RETURN NIL)) WHEN SPECIAL-FORM-P "~S: cannot trace special form ~S"
  61.       'TRACE ((RETURN NIL)) LET* SYMBOL-FUNCTION CONSP EQ GET
  62.       ('TRACING-DEFINITION) SETF ('TRACED-DEFINITION) PUSHNEW
  63.       (*TRACED-FUNCTIONS*) FORMAT "~&;; Tracing ~:[function~;macro~] ~S."
  64.       REPLACE-IN-FENV ('TRACED-DEFINITION) ('TRACING-DEFINITION) "TRACED-"
  65.       CONCAT-PNAMES (DECLARE (COMPILE) (INLINE CAR CDR CONS APPLY VALUES-LIST))
  66.       LET ((*TRACE-LEVEL* (TRACE-LEVEL-INC))) ((TRACE-PRE-OUTPUT)) TRACE-PRINT
  67.       MULTIPLE-VALUE-LIST ((BREAK-LOOP T)) *TRACE-VALUES* IF
  68.       ((TRACE-STEP-APPLY) (APPLY *TRACE-FUNCTION* *TRACE-ARGS*))
  69.       ((BREAK-LOOP T)) ((TRACE-POST-OUTPUT)) ((VALUES-LIST *TRACE-VALUES*)) NOT
  70.       FUNCTION LAMBDA &REST *TRACE-ARGS* &AUX *TRACE-FORM* MAKE-APPLY-FORM
  71.       (*TRACE-ARGS*) *TRACE-FUNCTION* GET-TRACED-DEFINITION CONS 'MACRO
  72.       (*TRACE-FORM* (CAR *TRACE-ARGS*)) CDR
  73.   )  )
  74. #Y(#:TOP-LEVEL-FORM-9 #16Y(00 00 00 00 00 01 D4 2D 01 D4 D6 30 96 BE 19 01)
  75.    REPLACE-IN-FENV REMOVE-OLD-DEFINITIONS
  76.    #Y(REPLACE-IN-FENV
  77.       #67Y(00 04 00 00 00 05 AC 86 33 04 AC 86 30 2B 00 19 05 14 6A 63 D5 1A 1A
  78.            AA A9 30 AC 57 14 99 22 0B AA 93 57 14 98 22 04 AC AB 94 58 D6 A9 79
  79.            02 33 00 A8 AA 86 28 61 00 19 08 AC D4 6A 50 89 00 51 00 19 06
  80.           )
  81.       5. 1. 2.
  82.   )  )
  83. #Y(#:TOP-LEVEL-FORM-10 #16Y(00 00 00 00 00 01 D4 2D 01 D4 D6 30 96 BE 19 01)
  84.    TRACE-LEVEL-INC REMOVE-OLD-DEFINITIONS
  85.    #Y(TRACE-LEVEL-INC #13Y(00 00 00 00 00 01 D4 63 01 34 01 19 01) #.#'1+
  86.       *TRACE-LEVEL*
  87.   )  )
  88. #Y(#:TOP-LEVEL-FORM-11 #16Y(00 00 00 00 00 01 D4 2D 01 D4 D6 30 96 BE 19 01)
  89.    GET-TRACED-DEFINITION REMOVE-OLD-DEFINITIONS
  90.    #Y(GET-TRACED-DEFINITION #13Y(00 01 00 00 00 02 D4 AA D5 34 02 19 02)
  91.       #.#'GET TRACED-DEFINITION
  92.   )  )
  93. #Y(#:TOP-LEVEL-FORM-12 #16Y(00 00 00 00 00 01 D4 2D 01 D4 D6 30 96 BE 19 01)
  94.    TRACE-STEP-APPLY REMOVE-OLD-DEFINITIONS
  95.    #Y(TRACE-STEP-APPLY
  96.       #32Y(00 00 00 00 00 01 D4 D5 D6 D7 63 04 00 55 72 D7 63 05 00 55 72 00 55
  97.            55 72 00 55 72 34 01 19 01
  98.           )
  99.       #.#'EVAL STEP APPLY QUOTE *TRACE-FUNCTION* *TRACE-ARGS*
  100.   )  )
  101. #Y(#:TOP-LEVEL-FORM-13 #16Y(00 00 00 00 00 01 D4 2D 01 D4 D6 30 96 BE 19 01)
  102.    MAKE-APPLY-FORM REMOVE-OLD-DEFINITIONS
  103.    #Y(MAKE-APPLY-FORM
  104.       #37Y(00 02 00 00 00 03 AA 5B AB 1A 0D 8B 00 D4 A9 00 55 72 7B 02 16 01 7A
  105.            00 92 20 70 16 01 A8 2F CC 16 01 55 19 03
  106.           )
  107.       QUOTE
  108.   )  )
  109. #Y(#:TOP-LEVEL-FORM-14 #16Y(00 00 00 00 00 01 D4 2D 01 D4 D6 30 96 BE 19 01)
  110.    TRACE-PRE-OUTPUT REMOVE-OLD-DEFINITIONS
  111.    #Y(TRACE-PRE-OUTPUT
  112.       #38Y(00 00 00 00 00 01 D4 63 01 34 01 D6 63 03 D8 63 01 D9 DA DB 5C 34 07
  113.            DC DD 63 01 34 02 DE 63 0B 63 01 34 02 19 01
  114.           )
  115.       #.#'TERPRI *TRACE-OUTPUT* #.#'WRITE *TRACE-LEVEL* :STREAM :BASE 10.
  116.       :RADIX #.#'WRITE-STRING " Trace: " #.#'PRIN1 *TRACE-FORM*
  117.   )  )
  118. #Y(#:TOP-LEVEL-FORM-15 #16Y(00 00 00 00 00 01 D4 2D 01 D4 D6 30 96 BE 19 01)
  119.    TRACE-POST-OUTPUT REMOVE-OLD-DEFINITIONS
  120.    #Y(TRACE-POST-OUTPUT
  121.       #51Y(00 00 00 00 00 01 D4 63 01 34 01 D6 63 03 D8 63 01 D9 DA DB 5C 34 07
  122.            DC DD 63 01 34 02 DE 0E 0B 70 D8 63 01 34 03 E0 E1 63 01 34 02 63 0E
  123.            5B 2E 0F 19 01
  124.           )
  125.       #.#'TERPRI *TRACE-OUTPUT* #.#'WRITE *TRACE-LEVEL* :STREAM :BASE 10.
  126.       :RADIX #.#'WRITE-STRING " Trace: " #.#'WRITE *TRACE-FORM*
  127.       #.#'WRITE-STRING " ==> " *TRACE-VALUES* TRACE-PRINT
  128.   )  )
  129. #Y(#:TOP-LEVEL-FORM-16 #16Y(00 00 00 00 00 01 D4 2D 01 D4 D6 30 96 BE 19 01)
  130.    TRACE-PRINT REMOVE-OLD-DEFINITIONS
  131.    #Y(TRACE-PRINT
  132.       #52Y(00 01 00 01 00 08 37 01 07 75 01 8A 01 0A 1A 03 8A 01 05 D4 63 01 34
  133.            01 94 1F 16 1A 06 D7 D8 63 01 34 02 8B 02 D6 A9 63 01 34 02 16 01 7A
  134.            02 20 6C 00 19 03
  135.           )
  136.       #.#'TERPRI *TRACE-OUTPUT* #.#'PRIN1 #.#'WRITE-STRING ", "
  137.   )  )
  138. #Y(#:TOP-LEVEL-FORM-17
  139.    #18Y(00 00 00 00 00 01 D4 2D 01 D4 D6 C1 72 30 96 BE 19 01) UNTRACE
  140.    REMOVE-OLD-DEFINITIONS MACRO
  141.    #Y(UNTRACE
  142.       #25Y(00 01 00 01 00 08 8C 02 D4 D5 8A 02 09 D7 AB 59 02 14 59 03 19 04 C0
  143.            1A 78
  144.           )
  145.       MAPCAN #'UNTRACE1 (COPY-LIST *TRACED-FUNCTIONS*) QUOTE
  146.   )  )
  147. #Y(#:TOP-LEVEL-FORM-18 #16Y(00 00 00 00 00 01 D4 2D 01 D4 D6 30 96 BE 19 01)
  148.    UNTRACE1 REMOVE-OLD-DEFINITIONS
  149.    #Y(UNTRACE1
  150.       #73Y(00 01 00 00 00 02 A9 86 2D 11 A9 D6 36 01 6A 98 89 00 1C 00 14 AB 2D
  151.            07 15 19 03 D4 D5 AB 5A 02 A8 AB 96 56 14 AB 2B 04 04 AA A9 30 96 1A
  152.            15 AA 84 54 0B 94 56 14 AB D7 36 01 30 98 21 62 D9 D5 AC 2B 03 06 AA
  153.            59 01 1A 4B
  154.           )
  155.       "~S: function name should be a symbol, not ~S" UNTRACE TRACED-DEFINITION
  156.       TRACING-DEFINITION REPLACE-IN-FENV
  157.       "~S: ~S was traced and has been redefined!" WARN UNTRACE2
  158.   )  )
  159. #Y(#:TOP-LEVEL-FORM-19 #16Y(00 00 00 00 00 01 D4 2D 01 D4 D6 30 96 BE 19 01)
  160.    UNTRACE2 REMOVE-OLD-DEFINITIONS
  161.    #Y(UNTRACE2
  162.       #27Y(00 01 00 00 00 02 A9 D4 30 9D A9 D5 30 9D A9 63 02 36 07 C1 EC 30 6D
  163.            0F 02 19 02
  164.           )
  165.       TRACED-DEFINITION TRACING-DEFINITION *TRACED-FUNCTIONS* #.#'EQ
  166.   )  )